home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
alph100p.zip
/
DEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-11-02
|
16KB
|
456 lines
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
{$M 1024,0,0}
program AlphaDemo;
uses
wow,
ALPHA;
Var
N, XX: byte;
procedure PrimaryFileExit; Far;
begin
{-vvvv PUT YOUR VERY LAST SCREEN DISPLAY & CODE HERE vvvvvvv-}
writeln;
Writeln;
Writeln(' PARTING COMMENTS:');
Writeln;
Writeln(' ALPHA automatically keeps track of your programs starting DOS environment.');
Writeln(' It can automatically restore these values when your program terminates');
Writeln(' with ALPHA''s Exit Procedure. In addition, ALPHA can provide for an exit');
Writeln(' Procedure for your main program, too.');
Writeln;
Writeln(' Both of these features are optional and need to be requested by you, in the');
Writeln(' StartUp procedure.');
Writeln;
Writeln(' Since a mode change will result in a total loss of all displayed messages,');
Writeln(' any parting comments to your users must be made in this Main Program Exit');
Writeln(' Procedure. Be sure, to keep it simple and leave out color.');
Writeln;
writeln(' Study this DEMO program for actual programming examples.');
{-^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^-}
(* Halt(ExitCode); { Your PC will lock up without this line! } *)
end;
procedure StartUp;
begin
LastProc:=@PrimaryFileExit; { if you want ALPHA to Add a Main Exit Procedure }
MakeAlphaChoice(Cga16_Mode); { Informs ALPHA that you want 16 background colors on a CGA }
{----------------------------------------------------}
randomize;
TextMode(CO40);
Prepare8Page(first,off,white,blue8);
pause(1);
gotoxy(1,10);
EchoLn(' THE ALPHA DEMO');
echoln('');
echoln(' version 1.00');
pause(4);
TextMode(CO80);
cursor(off); { cursor needs to be reset after textmode change }
cls; { paints screen blue }
gotoxy(1,10);
echoln(' Copyright (C) 1991, John H. Gohde, All rights reserved');
pause(3);
cls;
gotoxy(1,10);
EchoLn(' NOTE: This DEMO will demonstrate VGA, EGA, and CGA features.');
EchoLn(' Yet, due to the clever programming of the ALPHA unit this program');
EchoLn(' will run as is, without any changes on: MONO, CGA, EGA, VGA, PGA,');
EchoLn(' and MCGA monitors.');
echoln('');
EchoLn(' You too can write ONE program that will work with one set of');
EchoLn(' instructions that will run on ALL available monitors with ALPHA!!!');
pause(15);
cls; { you can not see writeln when it is re-directed }
gotoxy(1,10);
WriteLn(' Here is some of the info that ALPHA knows:');
WriteLn('');
WriteLn(' Video Adapter=',VideoAdapter2Str(VideoAdapter):10);
WriteLn(' Text Mode=',LastMode:14);
WriteLn(' Foreground=',Color2Str(GetForeground(TextAttr)):13);
WriteLn(' Background=',Color2Str(GetBackground(TextAttr)):13);
WriteLn(' Number of Rows=',MaxRows:9);
WriteLn(' Number of Columns=',MaxCols:6);
WriteLn(' Current Page=',Pages2Str(LastPage):11);
WriteLn(' Active Page=',Pages2Str(getactivepage):12);
pause(15);
{----------------------------------------------------}
end;
Procedure CursorDemo;
begin
PreparePage(First ,ON ,white,green);
writeln;
writeln(' ...demonstrating ALPHA''s new CURSOR features:');
gotoxy(05,5);write('NOTE note how APLHA can set the cursor to a block format.');
CURSOR(BLOCK);pause(3);
GotoXY(05,5);ClrEol;GotoXY(05,5);cursor(off);
write('NOTE note how APLHA can turn the cursor off.');pause(3);
GotoXY(05,5);ClrEol;GotoXY(05,5);
write('NOTE how APLHA can reverse colors.');pause(2);
reversecolorXY(5,5,34);pause(3);
GotoXY(05,5);ClrEol;GotoXY(05,5);
write('NOTE how APLHA can change colors.');pause(2);
ChangeColorXY(5,5,33,black,red);pause(5);
end;
Procedure CrtFeatures;
Procedure Reset;
begin
XX:=TextAttr;
Cls;gotoxy(10,2);TextColor(White);
writeln('...demonstrating ALPHA''s standard CRT unit features:');
TextAttr:=XX;
end;
Procedure TextModeDemo(N: WORD);
Const
Mode: array [0..5] of str7 = ('BW40','CO40','BW80','CO80','MONO','FONT8X8');
begin
TextMode(N);
Case N of
7: N:=4;
256: N:=5;
end;
writeln;writeln;
writeln('...demonstrating ALPHA''s standard CRT unit features:');
writeln;writeln;
writeln(' The TEXTMODE statement is used to change your video modes.');
WRITELN;writeln;
writeln(' This screen demonstrates changing to ',Mode[N],' textmode.');
pause(5);
end;
begin
PreparePage(First,Off,yellow ,Magenta );
TextModeDemo(CO80);
if VideoAdapter <> MDA then
begin
TextModeDemo(FONT8X8);
TextModeDemo(BW40);
TextModeDemo(BW80);
TextModeDemo(co40);
TextModeDemo(co80);
end;
HighVideo;CLS;
gotoxy(10,2);
writeln('...demonstrating ALPHA''s standard CRT unit features:');
writeln;
GotoXY(1,12);WriteChar('1',80);GotoXY(1,13);WriteChar('2',80);
GotoXY(1,14);WriteChar('3',80);GotoXY(1,15);WriteChar('4',80);
GotoXY(1,16);WriteChar('5',80);GotoXY(1,17);WriteChar('6',80);
GotoXY(1,18);WriteChar('7',80);GotoXY(1,19);WriteChar('8',80);
GotoXY(1,20);WriteChar('9',80);GotoXY(1,21);WriteChar('0',80);delay(250);
GotoXY(05,5);ClrEol;GotoXY(05,5);
write('The WHEREX statement shows the X position on the screen.');
reversecolorxy(9,5,6);cursor(off);gotoxy(33,15);N:=whereX;GotoXY(05,7);
write('The X position is ',n,'.');gotoxy(33,15);cursor(block);pause(5);
GotoXY(05,5);ClrEol;GotoXY(05,5);
write('The WhereY statement shows the Y position on the screen.');
reversecolorxy(9,5,6);cursor(off);gotoxy(33,15);N:=whereY;GotoXY(05,7);
write('The Y position is ',n,'.');gotoxy(33,15);cursor(block);pause(5);
GotoXY(05,7);ClrEol;
GotoXY(05,5);ClrEol;
write('The CLREOL statement will clear to the end of a line.');
reversecolorxy(9,5,6);gotoxy(33,15);cursor(block);pause(2);
clrEol;pause(2);
GotoXY(05,5);ClrEol;
write('The INSLINE statement does a scroll down the screen.');
reversecolorxy(9,5,7);GotoXY(05,18);;delay(500);
InsLine;delay(500);InsLine;delay(500);InsLine;pause(2);
GotoXY(05,5);ClrEol;
write('The DELLINE statement does a scroll up the screen.');
reversecolorxy(9,5,7);GotoXY(05,18);
delLine;delay(500);delLine;delay(500);delLine;delay(500);
cursor(off);Gotoxy(1,12);Writechar(#32,1500);
GotoXY(05,5);ClrEol; {TextColor(Yellow);}
write('Set foreground color with the TEXTCOLOR statement.');
reversecolorxy(35,5,9);pause(3);
GotoXY(05,5);TextColor(Yellow);ClrEol;
write('Set foreground color with the TEXTCOLOR statement.');
reversecolorxy(35,5,9);pause(3);
gotoxy(5,5);ClrEol;
Write('Set background color with the TEXTBACKGROUND statement.');
reversecolorxy(35,5,14);pause(3);
TextBackground(lightblue);reset;gotoxy(5,5);
Write('Set background color with the TEXTBACKGROUND statement.');
reversecolorxy(35,5,14);pause(3);
gotoxy(5,5);ClrEol;
write('You turn off HIGHVIDEO by using the LOWVIDEO statement.');
reversecolorxy(41,5,8);pause(3);
gotoxy(5,5);ClrEol;LowVideo;
write('You turn off HIGHVIDEO by using the LOWVIDEO statement.');
reversecolorxy(41,5,8);pause(3);
gotoxy(5,5);ClrEol;
write('You turn ON 16 Foreground colors by using the HIGHVIDEO statement.');
reversecolorxy(51,5,9);pause(3);
HighVideo;reset;gotoxy(5,5);
write('You turn ON 16 Foreground colors by using the HIGHVIDEO statement.');
reversecolorxy(51,5,9);pause(3);
gotoxy(5,5);ClrEol;
write('You can reset starting color by using the NORMVIDEO statement.');
reversecolorxy(47,5,9);pause(3);
NormVideo;reset;gotoxy(5,5);
write('You can reset starting color by using the NORMVIDEO statement.');
reversecolorxy(47,5,9);pause(3);
SetColor(black,cyan);cls;
GotoXY(1,05);
writeln(' In general, the CRT features were provided ONLY so that ALPHA');
writeln(' would be fairly compatible with the CRT unit. Due to the greatly');
writeln(' enhanced features of ALPHA''s NEW statements, there exclusive');
writeln(' use is highly recommended.');
writeln;
writeln(' Above ALL you should avoid using the WRITE statements. While this');
writeln(' DEMO shows that WRITE can work with ALPHA, it will actually work');
writeln(' ONLY under certain circumstances.');
writeln;
writeln(' ALPHA provides DISPLAY statements to be used in leu of WRITE. The');
writeln(' DISPLAY statement makes writing to the screen much more easier');
writeln(' and direct than using WRITE.');
writeln;
writeln(' ALPHA provides ECHO statements to be used in leu of WRITE when');
writeln(' both redirection and COLOR is required at the same time. Yes,');
writeln(' this means that with ALPHA you can see everything that is being');
writeln(' redirected to the printer or a file on screen and in COLOR!');
pause(30);
cls;
GotoXY(01,05);
writeln(' CRT''s TEXTMODE statement has been modified so that an improper');
writeln(' MODE value will not lock up any PC. Hence, a program written for');
writeln(' a VGA will work on a MONO adapter!');
writeln;
writeln(' Likewise, the CRT statements TEXTCOLOR and TEXTBACKGROUND will');
writeln(' work on a MONO adapter even though the program was written for');
writeln(' a VGA.');
pause(20);cls;
end;
Procedure rainbow;
Procedure FirstPage;
var X,Y,x1,Y1:word;
begin
PreparePage(first,Off,black,black);
fillpage(shadelight);
Y1:=MaxRows;
X1:=MaxCols;
TextColor(white);
if VideoAdapter<>MDA then
begin
for Y:=1 to Y1 do
begin
for X:=1 to X1 do
begin
ChangeBackgroundXY(x,y,1,Random(15));
end;
end;
end;
SetColor(white,blue);
gotoxy(25,11);WriteChar(space,35);
display(25,12,' ALPHA lets you write to Video RAM. ');
gotoxy(25,13);WriteChar(space,35);
SetColor(white,Black);Display(35,02,' Video Page One ');
end;
Procedure SecondPage;
var L,n:byte;
begin
PreparePage(Second,Off,blue,lightgreen);
fillpage(shadelight);
L:=MaxCols;
for n:=15 downto 0 do ChangeBackgroundXY(1,N+5,L,N);
SetColor(white,blue);
gotoxy(20,11);WriteChar(space,45);
display(20,12,' ALPHA lets you write to hidden video Pages. ');
gotoxy(20,13);WriteChar(space,45);
SetColor(white,Black);Display(33,02,' Video Page Two ');
end;
Procedure ThirdPage;
var n:byte;
begin
PreparePage(third,Off,lightBlue,lightred);
FillPage(CrossWeave);
setcolor(black,yellow);
gotoxy(12,11);WriteChar(space,61);
display(12,12,' You can create multi-Pages that are hidden. Then display ');
display(12,13,' them instantaneously to your users. Writing to hidden Pages ');
display(12,14,' speeds up the apparent of your application. ');
gotoxy(12,15);WriteChar(space,61);
SetColor(white,Black);Display(32,02,' Video Page Third ');
end;
Procedure FourthPage;
var n:byte;
begin
PreparePage(fourth,Off,lightcyan,lightblue);
FillPage(Crosshatch);
setcolor(Green,white);
gotoxy(7,7);WriteChar(space,60);
display(7,8,' Most CRT adapters provide four four Pages. But, ALPHA does ');
display(7,9,' support a maximum of eight pages. As MONO adapters have ');
display(7,10,' only one page, pages should be written in sequence so that ');
display(7,11,' ALPHA can transparently display them one at a time. ');
gotoxy(7,12);WriteChar(space,60);
SetColor(white,Black);Display(32,02,' Video Page Four ');
end;
begin
PreparePage(second,off,white,black);
fillpage(shadelight);
Display(23,10,' ... ALPHA will now do some video magic: ');
SetActivePage(second);if VideoAdapter=MDA then Pause(2);
FirstPage;pause(2);
SetActivePage(first);
secondpage; if VideoAdapter=MDA then Pause(2);
thirdPage; if VideoAdapter=MDA then Pause(2);
fourthpage; if VideoAdapter=MDA then Pause(2);
pause(1);
SetActivePage(second);pause(2);
SetActivePage(third);pause(2);
SetActivePage(fourth);pause(5);
for N:=1 to 10 do
begin
SetActivePage(Pages(Random(3)));
delay(300)
end;
for N:=1 to 10 do
begin
SetActivePage(Pages(Random(3)));
delay(200)
end;
for N:=1 to 15 do
begin
SetActivePage(Pages(Random(3)));
delay(130)
end;
for N:=1 to 20 do
begin
SetActivePage(Pages(Random(3)));
delay(090)
end;
setActivePage(third);pause(5);
end;
Procedure AddedFunctionsDemo;
begin
HighVideo;
SetColor(yellow,blue);cls;
CLS;
gotoxy(10,2);
writeln('...demonstrating a few of ALPHA''s added features:');
PAUSE(2);
display(5,5,'Use Cursor(ON) to turn the cursor ON.');
N:=whereX;reversecolorxy(9,5,10);GotoX(N);;CURSOR(on);pause(3);
Home;ClrEol;
Display(5,5,'Use Cursor(BLOCK) to turn the BLOCK cursor on.');
N:=whereX;reversecolorxy(9,5,13);GotoX(N);CURSOR(BLOCK);pause(3);
Home;ClrEol;
Display(5,5,'Use Cursor(OFF) to turn the cursor OFF.');
N:=whereX;reversecolorxy(9,5,11);GotoX(N);CURSOR(off);pause(3);
GotoXY(05,5);ClrEol;GotoXY(05,5);
write('Use ReverseColorXY(9,5,22) to reverse the color of this line.');
reversecolorXY(9,5,22);pause(3);
Home;ClrEol;
Display(5,5,'Use Display to write to the screen.');
N:=whereX;reversecolorxy(9,5,7);GotoX(N);CURSOR(off);pause(3);
Home;ClrEol;
Display(5,5,'Use CLS to clear the screen or any Video Page with spaces.');
N:=whereX;reversecolorxy(9,5,3);GotoX(N);CURSOR(off);pause(3);
Display(5,7,'But use FillPage to fill a screen or Video Page with any Character.');
N:=whereX;reversecolorxy(13,7,8);GotoX(N);CURSOR(off);pause(3);
Home;ClrEol;
GotoXY(05,5);ClrEol;
Display(5,5,'Use SetBorder to change the border color.');
N:=whereX;reversecolorxy(9,5,9);GotoX(N);CURSOR(off);pause(3);
for n:=1 to 30 do begin setborder(random(16));delay(300);end;
pause(3);setborder(black);
Home;ClrEol;
Display(5,5,'Use SetPage to Display to a hidden Video Page.');
N:=whereX;reversecolorxy(9,5,7);GotoX(N);CURSOR(off);pause(3);
Display(5,7,'But use SetActivePage to Display a hidden Page to the screen.');
N:=whereX;reversecolorxy(13,7,13);GotoX(N);CURSOR(off);pause(3);
Home;ClrEol;
Home;ClrEol;
Display(5,5,'Use SetColor to change both Foreground/Background Color.');
N:=whereX;reversecolorxy(9,5,8);GotoX(N);CURSOR(off);pause(3);
Home;ClrEol;
Display(5,5,'Use ChangeColorXY to change the color of text at a position on the screen.');
N:=whereX;reversecolorxy(9,5,13);GotoX(N);CURSOR(off);pause(3);
Home;ClrEol;
Home;ClrEol;
Display(5,5,'Use Int2Str to Display whole numbers on screen.');
N:=whereX;reversecolorxy(9,5,7);GotoX(N);CURSOR(off);pause(3);
Display(5,7,'But use Real2Str display Real numbers on screen.');
N:=whereX;reversecolorxy(13,7,8);GotoX(N);CURSOR(off);pause(3);
Home;ClrEol;
rainbow;
end;
begin
StartUp; beep;
CursorDemo; beep;
CrtFeatures; beep;
AddedFunctionsDemo; beep;
end.